home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_emacs.idb / usr / freeware / share / emacs / 19.34 / lisp / docref.el.z / docref.el
Encoding:
Text File  |  1998-10-28  |  9.9 KB  |  283 lines
  1. ;;; docref.el --- Simple cross references for Elisp documentation strings
  2.  
  3. ;; Copyright (C) 1994 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Vadim Geshel <vadik@unas.cs.kiev.ua>
  6. ;; Created: 12 Jul 1994
  7. ;; Keywords: docs, help, lisp
  8. ;; original name was cross-ref.el.
  9.  
  10. ;; This file is part of GNU Emacs.
  11.  
  12. ;; GNU Emacs is free software; you can redistribute it and/or modify
  13. ;; it under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 2, or (at your option)
  15. ;; any later version.
  16.  
  17. ;; GNU Emacs is distributed in the hope that it will be useful,
  18. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;; GNU General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25. ;; Boston, MA 02111-1307, USA.
  26.  
  27. ;;; Commentary:
  28.  
  29. ;; This package allows you to use a simple form of cross references in
  30. ;; your Emacs Lisp documentation strings. Cross-references look like
  31. ;; \\(type@[label@]data), where type defines a method for retrieving
  32. ;; reference information, data is used by a method routine as an argument,
  33. ;; and label "represents" the reference in text. If label is absent, data
  34. ;; is used instead.
  35. ;; 
  36. ;; Special reference labeled `back', when present, can be used to return
  37. ;; to the previous contents of help buffer.
  38. ;;
  39. ;; Cross-referencing currently is intended for use in doc strings only
  40. ;; and works only in temporary buffers (created by `with-output-to-temp-buffer').
  41. ;; List of temp buffers in which cross-referencing is to be active is specified
  42. ;; by variable DOCREF-BUFFERS-LIST, which contains only "*Help*" by default.
  43. ;;
  44. ;; Documentation strings for this package's functions and variables can serve
  45. ;; as examples of usage.
  46. ;;
  47. ;;; Customization:
  48. ;; 
  49. ;; See source. The main customization variable is `docref-methods-alist'.
  50. ;; It consists of (type . function) pairs, where type is a string which
  51. ;; corresponds to type in cross-references and function is called with
  52. ;; one argument - reference `data' - when a reference is activated.
  53. ;;
  54. ;;; Installation:
  55. ;;
  56. ;; Place this file somewhere in your load-path, byte-compiled it, and add
  57. ;; (require 'cross-ref)
  58. ;; to your .emacs.
  59.  
  60. ;;; Code:
  61.  
  62. ;; User customizable variables
  63.  
  64. (defvar docref-highlight-p t
  65.   "*If non-nil, \\(f@docref-subst) highlights cross-references.
  66. Under window system it highlights them with face defined by
  67. \\(v@docref-highlight-face), on character terminal highlighted references
  68. look like cross-references in info mode.")
  69.  
  70. (defvar docref-highlight-face 'highlight
  71.   "*Face used to highlight cross-references (used by \\(f@docref-subst))")
  72.  
  73. (defvar docref-methods-alist
  74.   '(("f" . docref-describe-function)    ; reference to a function documentation
  75.     ("v" . docref-describe-variable)    ; reference to a variable documentation
  76.     ("F" . docref-read-file)        ; reference to a file contents
  77.     ("s" . docref-use-string)        ; reference to a string 
  78.     ("V" . docref-use-variable-value)    ; reference to variable value
  79.     ("0" . beep))            ; just highlighted text
  80.   "Alist which maps cross-reference ``types'' to retrieval functions.
  81.  
  82. The car of each element is a string that serves as `type' in cross-references.
  83. \(See \\(f@docref-subst)).  The cdr is a function of one argument,
  84. to be called to find this reference.")
  85.  
  86. (defvar docref-back-label "\nback"
  87.   "Label to use by \\(f@docref-subst) for the go-back reference.")
  88.  
  89. (defvar docref-back-reference nil
  90.   "If non-nil, this is a go-back reference to add to the current buffer.
  91. The value specifies how to go back.  It should be suitable for use
  92. as the second argument to \\(f@docref-insert-label).
  93. \\(f@docref-subst) uses this to set up the go-back reference.")
  94.  
  95. (defvar docref-last-active-buffer)
  96.  
  97. ;;;###autoload
  98. (defun docref-setup ()
  99.   "Process docref cross-references in the current buffer.
  100. See also \\(f@docref-subst)."
  101.   (interactive)
  102.   (docref-subst (current-buffer))
  103.   (docref-mode))
  104.  
  105. (defvar docref-mode-map nil)
  106. (or docref-mode-map
  107.     (let ((map (make-sparse-keymap)))
  108.       (define-key map [mouse-2] 'docref-follow-mouse)
  109.       (define-key map "\C-c\C-b" 'docref-go-back)
  110.       (define-key map "\C-c\C-c" 'docref-follow)
  111.       (setq docref-mode-map map)))
  112.  
  113. (defun docref-mode ()
  114.   "Major mode for help buffers that contain cross references.
  115. To follow a reference, move to it and type \\[docref-follow], or use
  116. \\[docref-follow-mouse].  The command \\[docref-go-back] can used to go
  117. back to where you came from."
  118.   (interactive)
  119.   (kill-all-local-variables)
  120.   (setq major-mode 'docref-mode)
  121.   (setq mode-name "Docref")
  122.   (use-local-map docref-mode-map)
  123.   (run-hooks 'docref-mode))
  124.  
  125. (defun docref-subst (buf)
  126.   "Parse documentation cross-references in buffer BUF.
  127.  
  128. Find cross-reference information in a buffer and
  129. highlight them with face defined by \\(v@docref-highlight-face).
  130.  
  131. Cross-reference has the following format: \\ (TYPE[@LABEL]@DATA), where
  132. TYPE defines method used to retrieve xref data (like reading from file or
  133. calling \\(f@describe-function)), DATA is an argument to this method
  134. \(like file name or function name), and LABEL is displayed in text using
  135. \\(v@docref-highlight-face).
  136.  
  137. The special reference `back' can be used to return back.
  138. The variable \\(v@docref-back-label) specifies the label to use for that.
  139.  
  140. See \\(v@docref-methods-alist) for currently defined methods."
  141.   (interactive "b")
  142.   (save-excursion
  143.     (set-buffer buf)
  144.     (goto-char (point-min))
  145.     ;; The docref-seen property indicates that we have processed this
  146.     ;; buffer's contents already, so don't do it again.
  147.     (if (not (get-text-property (point-min) 'docref-seen))
  148.     (let ((old-modified (buffer-modified-p)))
  149.       (while (re-search-forward "[\\](\\([^\)\@]+\\)\\(@[^\)\@]+\\)?@\\([^\)]*\\))"
  150.                     nil t)
  151.         (let* ((start (match-beginning 0))
  152.            (type (buffer-substring (match-beginning 1) (match-end 1)))
  153.            (data (buffer-substring (match-beginning 3) (match-end 3)))
  154.            (label
  155.             (if (match-beginning 2)
  156.             (buffer-substring (+ (match-beginning 2) 1) (match-end 2))
  157.               data)))
  158.           (replace-match "" t)
  159.           (docref-insert-label label (cons type data))))
  160.  
  161.       ;; Make a back-reference in this buffer, if desired.
  162.       ;; (This is true if called from docref-follow.)
  163.       (if docref-back-reference
  164.           (progn
  165.         (goto-char (point-max))
  166.         (put-text-property (point-min) (1+ (point-min))
  167.                    'docref-back-position (point))
  168.         (docref-insert-label docref-back-label docref-back-reference)))
  169.       (put-text-property (point-min) (1+ (point-min)) 'docref-seen t)
  170.       (set-buffer-modified-p old-modified)))))
  171.  
  172. (defun docref-insert-label (string ref)
  173.   (let ((label (concat string))
  174.     (pos (point)))
  175.     ;; decorate the label
  176.     (let ((leading-space-end (save-match-data
  177.                    (if (string-match "^\\([ \t\n]+\\)" label)
  178.                    (match-end 1)
  179.                  0)))
  180.       (trailing-space-start (save-match-data
  181.                   (if (string-match "\\([ \t\n]+\\)$" label)
  182.                       (match-beginning 1)
  183.                     (length label)))))
  184.       (if docref-highlight-p          
  185.       (if (not window-system)
  186.           (setq label
  187.             (concat (substring label 0 leading-space-end)
  188.                 "(*note "
  189.                 (substring label leading-space-end trailing-space-start)
  190.                 ")"
  191.                 (substring label trailing-space-start)))
  192.         ;; window-system
  193.         (put-text-property leading-space-end
  194.                    trailing-space-start
  195.                    'face docref-highlight-face label)))
  196.       (put-text-property 0 (length label) 'docref ref label)
  197.       (insert label))))
  198.  
  199. (defun docref-follow-mouse (click)
  200.   "Follow the cross-reference that you click on."
  201.   (interactive "e")
  202.   (save-excursion
  203.     (let* ((start (event-start click))
  204.        (window (car start))
  205.        (pos (car (cdr start)))
  206.        (docref-last-active-buffer (current-buffer)))
  207.       (set-buffer (window-buffer window))
  208.       (docref-follow pos))))
  209.  
  210. (defun docref-go-back ()
  211.   "Go back to the previous contents of help buffer."
  212.   (interactive)
  213.   (let ((pos (get-text-property (point-min) 'docref-back-position)))
  214.     (if    pos
  215.     (docref-follow pos)
  216.       (error "No go-back reference"))))
  217.  
  218. (defun docref-follow (&optional pos)
  219.   "Follow cross-reference at point.
  220. For the cross-reference format, see \\(f@docref-subst).
  221. The special reference named `back' can be used to return back"
  222.   (interactive)
  223.   (or pos (setq pos (point)))
  224.   (let ((docref-data (get-text-property pos 'docref)))
  225.     (if docref-data
  226.     ;; There is a reference at point.  Follow it.
  227.     (let* ((type (car docref-data))
  228.            (name (cdr docref-data))
  229.            (method (assoc type docref-methods-alist))
  230.            (cur-contents (buffer-string))
  231.            (opoint (point))
  232.            (docref-back-reference (cons "s" cur-contents))
  233.            success)
  234.       (if (null method)
  235.           (error "Unknown cross-reference type: %s" type))
  236.       (unwind-protect
  237.           (save-excursion
  238.         (funcall (cdr method) name)
  239.         (setq success t))
  240.         (or success
  241.         (progn
  242.           ;; (cdr method) got an error.
  243.           ;; Put back the text that we had.
  244.           (erase-buffer)
  245.           (insert cur-contents)
  246.           (goto-char opoint)))
  247.         (set-buffer-modified-p nil))))))
  248.  
  249. ;; Builtin methods for accessing a reference.
  250.  
  251. (defun docref-describe-function (data)
  252.   (save-excursion
  253.     (if (boundp 'docref-last-active-buffer)
  254.     (set-buffer docref-last-active-buffer))
  255.     (describe-function (intern data))))
  256.   
  257. (defun docref-describe-variable (data)
  258.   (save-excursion
  259.     (if (boundp 'docref-last-active-buffer)
  260.     (set-buffer docref-last-active-buffer))
  261.     (describe-variable (intern data))))
  262.  
  263. (defun docref-read-file (data)
  264.   (with-output-to-temp-buffer (buffer-name)
  265.     (erase-buffer)
  266.     (insert-file-contents (expand-file-name data))))
  267.  
  268. (defun docref-use-string (data)
  269.   (with-output-to-temp-buffer (buffer-name)
  270.     (erase-buffer)
  271.     (insert data)))
  272.  
  273. (defun docref-use-variable-value (data)
  274.   (let ((sym (intern data)))
  275.     (with-output-to-temp-buffer (buffer-name)
  276.       (erase-buffer)
  277.       (princ (symbol-value sym)))))
  278.  
  279. (provide 'docref)
  280.  
  281. ;;; docref.el ends here
  282.  
  283.